perm filename GEOMES[SAI,BGB] blob
sn#056549 filedate 1973-08-05 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 TITLE GEOMES - GEOMETRIC MODELING EMBEDDED IN SAIL - BGB 1973.
00005 00003 SUBR(MORCOR)------------------------------------------------------
00007 00004 III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
00011 00005 SUBR(DECDPY)NUMBER------------------------------------------------
00013 00006 SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
00015 00007 VERNIER III TEXT POSITIONING.
00017 00008 SUBR(FDPY)F-------------------------------------------------------
00019 00009 SUBR(IDPY)NODE----------------------------------------------------
00021 ENDMK
⊗;
TITLE GEOMES - GEOMETRIC MODELING EMBEDDED IN SAIL - BGB 1973.
;-----------------------------------------------------------------
;AD HOC TOP LEVEL OF GEOMES - TEMPORARY VERSION FOR RUSS TAYLOR.
INTERN UNIVER,BLKCNT,AVAIL,CAMERA
UNIVER: 0 ;POINTER TO THE UNIVERSE NODE.
BLKCNT: 0 ;NUMBER OF NODES IN USE.
AVAIL: 0 ;POINTER TO EMPTY NODE LIST.
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
CAMERA:0↔WINDOW:0 ;WHICH ARE HERE AND SHOULDN'T BE.
SUBR(MKNODE)TYPE--------------------------------------------------
BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
SKIPE AVAIL
SKIPN 1,@AVAIL↔CALL(MORCOR)
CDR -3(1)↔DAP @AVAIL
DZM -3(1)↔AOS @BLKCNT
POP P,.+3↔POP P,(1)↔GO @.+1↔0
BEND;1/12/73------------------------------------------------------
SUBR(KLNODE)NODE--------------------------------------------------
BEGIN KILL; - RELEASE BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
LAC 1,ARG1
SOS @BLKCNT
LIPI -3(1)↔LAPI -2(1)
SETZM -3(1)↔BLT 8(1) ;CLEAR NODE.
LAC@AVAIL↔DAPZ -3(1)
DAPZ 1,@AVAIL
POP1J
BEND;1/12/73------------------------------------------------------
SUBR(GEODPY)
POP0J
SUBR(MORCOR)------------------------------------------------------
BEGIN MORCOR; - GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
EXTERN CORGET
PUSH P,2↔PUSH P,3
SETZ 2,
L1: LACI 3,NODSIZ*=400 ;AC3 SIZE OF SPACE.
CALL(CORGET) ;AC2 ADDRESS OF SPACE.
GO[FATAL(NO MORE CORE.)]
SLACI(2)↔LAPI 1(2)↔DZM(2)
BLT NODSIZ*=400-1(2) ;CLEAR BLOCK OF MEMORY.
LACI 1,3(2) ;ORIGIN OF FIRST NODE.
;INITIALIZE THE UNIVERSE WHEN NECESSARY.
SKIPE UNIVER↔GO L3
LACI -2(1)↔DAC AVAIL ;POINTER TO AVAIL LIST.
LACI -1(1)↔DAC BLKCNT ;POINTER TO NODE COUNT.
DAC 1,UNIVERSE ;POINTER TO UNIVERSE NODE.
;MAKE AVAIL LIST.
L3: DIP 1,1
ADD 1,[XWD NODSIZ,0]
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
AOS@BLKCNT↔SUBI 3,NODSIZ↔GO .+1]
SUBI 3,NODSIZ
DAPZ 1,@AVAIL
;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2: HLRZM 1,-3(1) ;EMPTY LIST POINTER.
ADD 1,[XWD NODSIZ,NODSIZ]
SUBI 3,NODSIZ
JUMPN 3,L2
LAC 1,@AVAIL
POP P,3↔POP P,2
POP0J
BEND;1/12/73------------------------------------------------------
;III DISPLAY SUBROUTINES-BGB-JANUARY 1973----------------------
A←1↔B←2↔C←3
INTERN BUFDPY↔BUFDPY:.+2↔=100↔BLOCK =100
INTERN DPYBUF↔DPYBUF:DPYBU.↔=2048 ↔ DPYBU.: BLOCK =2048
IGNORE:0↔DPYPTR:0↔BUFEND:0
BUFHD:0↔0;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
;--------------------------------------------------------------
INTERN DPYSET,DPYOUT,DPYBRT,AIVECT,AVECT,DPYSTR,DTYO,DPYBIG
DPYSET: LAC 1,ARG1↔CDR 2,-1(1) ;BUFFER SIZE.
ADDI 2,-1(1)↔DAC 2,BUFEND
ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
SETZM IGNORE
CLR2: LAC A,BUFHD↔LACI B,1↔DAC B,1(A)
LACI B,2(A)↔LIPI B,1(A)↔BLT B,@BUFEND
PUSH P,(P)↔GO LV3
;--------------------------------------------------------------
DPYBIG: SKIPE IGNORE↔POP1J
LAC A,ARG1↔LACI C,46↔DPB A,[POINT 3,3,27]
PUSH P,(P)↔GO LV2
DPYBRT: SKIPE IGNORE↔POP1J
LAC 1,ARG1↔LACI C,46↔DPB A,[POINT 3,3,24]
PUSH P,(P)↔GO LV2
;--------------------------------------------------------------
AIVECT: SKIPA C,[146] ;INVISIBLE ABSOLUTE.
AVECT: LACI C,106
SKIPGE IGNORE↔POP2J
LV: LAC A,ARG2↔LAC B,ARG1
LVC: DPB A,[POINT 11,C,10]
DPB B,[POINT 11,C,21]
LV2: AOS A,DPYPTR↔DAC C,(A)
LV3: LIPI A,<(<POINT 7,0,35>)>
DAC A,DPYPTR↔LACI A,(A)
CAML A,BUFEND↔SETOM IGNORE
POP2J
;--------------------------------------------------------------
DPYSTR: LAC 3,ARG1↔LIPI 3,440700
ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYSTR+2
DTYO: LAC 1,ARG1↔IDPB 1,DPYPTR
CDR 1,DPYPTR↔CAML 1,BUFEND
SETOM IGNORE↔POP1J
;--------------------------------------------------------------
DPYOUT: SKIPN 1,BUFHD↔GO .+6
LAC 2,DPYPTR↔DAC 2,-2(1)
LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
CDR B,DPYPTR↔SUB B,BUFHD
AOS B↔DAC B,BUFHD+1
LAC 1,ARG1↔DPB A,[POINT 4,.+1,12]↔703B8+BUFHD
POP1J
;--------------------------------------------------------------
DPYSST↑: POP 16,1↔POP 16,2↔SKIPGE IGNORE↔POPJ P,
HRRZS 2 ;LENGTH OF STRING.
JUMPLE 2,SSRET
ILDB 3,1
IDPB 3,DPYPTR
SOJG 2,.-2
SSRET: HRRZ 1,DPYPTR
CAML 1,BUFEND
SETOM IGNORE
POPJ P,
SUBR(DECDPY)NUMBER------------------------------------------------
BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
LAC 1,ARG1↔POP P,ARG1 ;GET ARG AND ADJUST STACK.
L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
LAC 1,2
L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
POP0J
BEND;12/17/72-----------------------------------------------------
SUBR(FLODPY)FLONUM,PLACES-----------------------------------------
BEGIN FLODPY;FLOATING NUMBER DISPLAY - BGB - 4 FEB 1973.
LAC ARG2↔JUMPL[CALL(DTYO,["-"])↔LACM ARG2↔GO .+1]
LACM 2,ARG1↔CAILE 2,6↔LACI 2,6↔DAC 2,ARG1
FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSH P,1↔CALL(DECDPY,0)↔POP P,0↔LAC 2,ARG1
ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSH P,DPYPTR↔CALL(DECDPY,0)↔POP P,1
LACI "."↔IDPB 0,1↔POP2J↔LIT
BEND;2/4/73-------------------------------------------------------
SUBR(IIIDPY)WINDOW,GLASS -----------------------------------------
BEGIN IIIDPY; DISPLAY DEVICE ROUTINE.
E←←16
;DISPLAY WINDOW FRAME.
LAC 1,ARG2
NIP 1(1)↔DAC XL
NAP 1(1)↔DAC XH
NIP 2(1)↔DAC YL
NAP 2(1)↔DAC YH
CALL(DPYSET,DPYBUF)
CALL(AIVECT,XL,YL)
CALL(AVECT,XH,YL)
CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)
CALL(AVECT,XL,YL)
;DISPLAY THE VISIBLE EDGE LIST.
LAC E,ARG2
ALT2 E,E↔JUMPE E,L2 ;GET THE WORLD.
PED E,E↔SKIPA ;FIRST EDGE OF WORLD.
L1: ALT2 E,E↔JUMPE E,L2 ;GET AN EDGE.
X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT,1,2)
X2DC 1,E↔Y2DC 2,E↔CALL(AVECT,1,2)
GO L1
L2: CALL(DPYOUT,ARG1)
POP2J
DECLARE{XL,XH,YL,YH}
BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
;VERNIER III TEXT POSITIONING.
VERNX ←← 14
VERNY ←← 11
SUBR(VDPY)V-------------------------------------------------------
BEGIN VDPY;SPECIAL VERTEX DISPLAY - BGB - 9 JANUARY 1973.
LAC 1,ARG1↔CAR 0,(1)↔ANDI 0,017400 ;NSEW & PZZ.
SKIPE↔POP1J
XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
CALL(IDPY,ARG1)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
POP1J
BEND;2/9/73-------------------------------------------------------
SUBR(EDPY)E-------------------------------------------------------
BEGIN EDPY;SPECIAL EDGE DISPLAY - BGB - 9 FEBRUARY 1973.
CALL(DPYBIG,[1])↔CALL(DPYBRT,[3])
LAC 2,ARG1
PVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L1
XDC 0,1↔FIXX↔DAC X↔PUSH P,0
YDC 0,1↔FIXX↔DAC Y↔PUSH P,0
PUSH P,ARG1↔PUSH P,ARG1
PUSHJ P,AIVECT
CALL(DTYO,["+"])↔CALL(AIVECT)
L1: LAC 2,ARG1
NVT 1,2↔CAR 0,(1)↔ANDI 0,017400↔JUMPN L2
XDC 0,1↔FIXX↔ADDM X↔PUSH P,0
YDC 0,1↔FIXX↔ADDM Y↔PUSH P,0↔PUSHJ P,AVECT
CALL(DTYO,["-"])
L2: LAC 2,ARG1
LAC X↔ASH -1↔PUSH P,0
LAC Y↔ASH -1↔PUSH P,0
CALL(AIVECT)↔CALL(IDPY,ARG1)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
POP1J
DECLARE{X,Y}
BEND;2/9/73-------------------------------------------------------
SUBR(FDPY)F-------------------------------------------------------
BEGIN FDPY;SPECIAL FACE DISPLAY - BGB - 9 FEBRUARY 1973.
EXTERN ECCW
LAC 1,ARG1↔DAC 1,F
TEST 1,FBIT↔POP1J
PED 2,1↔DAC 2,E↔DAC 2,E0
SETZM I
CALL(DPYBIG,[1])
CALL(DPYBRT,[3])
SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
X1DC 0,2↔DAC 0,X
Y1DC 1,2↔DAC 1,Y
CALL(AIVECT,0,1)↔LAC 2,E
X2DC 0,2↔ADDM 0,X
Y2DC 1,2↔ADDM 1,Y
CALL(AVECT,0,1)
LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
CALL(AIVECT,0,1)
CALL(DECDPY,I)
L2: CALL(ECCW,E,F)
CAMN 1,E↔GO L3↔DAC 1,E
CAME 1,E0↔GO L1
L3: CALL(DPYBRT,[2])
CALL(DPYBIG,[2])
POP1J
DECLARE{F,E,E0,X,Y,I}
BEND;2/9/73-------------------------------------------------------
SUBR(IDPY)NODE----------------------------------------------------
BEGIN IDPY; IDENTIFIER DISPLAY.
EXTERN CAMERA
LAC 1,ARG1↔SETZ 2,
TESTZ 1,BBIT↔GO[
SKIPE 4(1)↔GO[SETZ↔ALT. 0,1↔LACI 4(1)
CALL(DPYSTR,0)↔GO L1A]
L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
CALL(DECDPY)
L1A: SETZB 14,15↔LAC 1,ARG1
TESTZ 1,BDLBIT↔IORI 14,4
TESTZ 1,BDVBIT↔IORI 14,2
TESTZ 1,BDPBIT↔IORI 14,1
JUMPE 14,POP1J.
LAC 14,[
0↔ASCII/.P./↔ASCII/.V./↔ASCII/.VP./
ASCII/.L./↔ASCII/.LP./
ASCII/.LV./↔ASCII/.LVP./](14)
CALL(DPYSTR,[14])↔POP1J]
TESTZ 1,FBIT↔GO[
L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
CALL(DECDPY)↔POP1J]
TESTZ 1,EBIT↔GO[
L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
CALL(DECDPY)↔POP1J]
TESTZ 1,VBIT↔GO[
L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
CALL(DECDPY)↔POP1J]
CAMN 1,CAMERA↔GO[CALL(DPYSTR,{[[ASCIZ"CAMERA"]]})↔POP1J]
CALL(DPYSTR,{[[ASCIZ"UNDEF"]]})
POP1J
LIT
BEND;2/4/73-------------------------------------------------------
END